#!/usr/local/bin/perl
use CPANPLUS;
use Module::CoreList;
use Module::ExtractUse;
use Module::ScanDeps;
use FindBin qw($Script);
use File::Find;
use Data::Dumper;
use Cwd;
use Getopt::Std;
use strict;

my %opt;
getopts('esvd', \%opt);

my $cb      = new CPANPLUS::Backend;
my $perl = 5;
my $dat = "$Script.$$";

my %T;	# full path of test files (e.g. "*.t")
my %PM; # full path of module files (e.g. "*.pm")
my %MOD; # module name
my %DEP;
my %REQ;
my %PERL; # PERL version scanned from ports, ('5.6.2', '5.8.8')
my $PORTSDIR = '/usr/ports';
my $INDEX = "$PORTSDIR/INDEX-7";
my %INDEX;

open(F, $INDEX) || die $!;
while(<F>)
{
  next if !m{\bperl-\d+};
  my $ver = $1 if m{^perl-([\d\.]+)};
  $PERL{$ver} = $ver if $ver;
  my @f = split('\|');
  my $pkgname = pkgname($f[0]);
  my $path = $f[1];
  $path =~ s{$PORTSDIR/}{};
  $INDEX{$pkgname} = $path;
}
close(F);
my $perl_min = (sort keys %PERL)[0];
my $perl_max = (sort keys %PERL)[-1];
my $perl_used = $perl_min;
my $modbuild = 0;
chomp(my $WRKSRC = `make -V WRKSRC`);
my $cwd = getcwd();
print "# make depends extract\n" if $opt{v};
system("make depends extract > /dev/null") == 0 or die $?;
my $PL = (-f "$WRKSRC/Makefile.PL") ? 'Makefile.PL' : 'Build.PL';
$modbuild = 1 if $PL eq 'Build.PL';
print "# cd $WRKSRC && echo | perl $PL\n" if $opt{v};
`cd $WRKSRC && echo | perl $PL > /dev/null`;
my $deps;
if (-f "$WRKSRC/META.yml") {
  require Module::Depends;
  $deps = Module::Depends->new->dist_dir($WRKSRC)->find_modules;
} else {
  require Module::Depends::Intrusive;
  $deps = Module::Depends::Intrusive->new->dist_dir($WRKSRC)->find_modules;
}
print "deps: ".Dumper($deps) if $opt{d};
my $PREREQ_PM;
foreach my $r (qw(build_requires requires))
{
  next if !defined($deps->$r);
  foreach my $d (keys %{$deps->$r})
  {
    $PREREQ_PM->{$d} = $deps->$r->{$d};
  }
}
if (defined($deps->build_requires) && scalar(keys %{$deps->build_requires})) {
  $REQ{'RUN'} = $deps->requires;
  $REQ{'BUILD'} = $deps->build_requires;
} elsif ($opt{e} || $opt{s}) {
  $REQ{'RUN'} = $deps->build_requires;
} else {
  $REQ{'RUN'} = $deps->requires;
}
print "# REQ: " . Dumper(\%REQ) . "\n" if $opt{d};
print "# PREREQ_PM: " . Dumper($PREREQ_PM) . "\n" if $opt{d};
print "# make\n" if $opt{v};
system("make > /dev/null") == 0 or die $?;
print "# Scanning $WRKSRC\n" if $opt{v};
find(\&wanted, $WRKSRC);
die "no *.pm ?" if !scalar(%PM);
print "MOD:\n".Dumper(\%MOD) if $opt{d};
print "PM:\n".Dumper(\%PM) if $opt{d};
print "T:\n".Dumper(\%T) if $opt{d};

print "# Constructing REQ{RUN}:\n" if $opt{v};
# construct REQ{RUN} based on PM
if ($opt{s})
{
  my $PM = scan_deps(files => [ keys %PM ], recurse => 0, warn_missing => 0);
  foreach my $entry (keys %$PM)
  {
    next if $PM->{$entry}->{'type'} ne 'module';
    my $mod = $entry;
    $mod =~ s{\.pm$}{};
    $mod =~ s{/}{::}g;
    $REQ{'RUN'}{$mod} = 1;
  }
}
if ($opt{e})
{
  foreach my $pm (keys %PM)
  {
    print "# extract_use($pm)\n" if $opt{d};
    my $p = Module::ExtractUse->new;
    $p->extract_use($pm);
    foreach my $used (keys %{$p->used})
    {
      next if !$used;
      print "# use $used;\n" if $opt{d};
      if ($used =~ m{^[\d\.\_]+$}) {
	if (!$perl_used or level($perl_used) < level($used)) {
	  $perl_used = $used;
	  print "# PERL_MIN bumped to $perl_used in pm:$pm\n" if $opt{d};
	}
      } elsif ($used =~ m{^[\w\:]+$}) {
	$REQ{'RUN'}{$used} = 1;
      } else {
	warn "Unknown REQ{RUN}: $used" if $opt{d};
      }
    }
  }
}

print "# Constructing REQ{BUILD}\n" if $opt{v};
# construct REQ{BUILD} based on T
if ($opt{s})
{
  my $T = scan_deps(files => [ keys %T ], recurse => 0, warn_missing => 0);
  foreach my $entry (keys %$T)
  {
    next if $T->{$entry}->{'type'} ne 'module';
    my $mod = $entry;
    $mod =~ s{\.pm$}{};
    $mod =~ s{/}{::}g;
    $REQ{'BUILD'}{$mod} = 1;
  }
}
if ($opt{e})
{
  foreach my $t (keys %T)
  {
    next if (!$modbuild && $t =~ m{Build.PL$});
    print "# extract_use($t)\n" if $opt{d};
    my $p = Module::ExtractUse->new;
    $p->extract_use($t);
    foreach my $used (keys %{$p->used})
    {
      next if !$used;
      print "# use $used;\n" if $opt{d};
      if ($used =~ m{^[\d\.\_]+$}) {
	if ($t =~ m{\.PL$} and (!$perl_used or level($perl_used) < level($used))) {
	  $perl_used = $used;
	  print "# PERL_MIN bumped to $perl_used in t:$t\n" if $opt{d};
	}
      } elsif ($used =~ m{^[\w\:]+$}) {
	$used =~ s{^inc::}{};
	$REQ{'BUILD'}{$used} = 1;
      } else {
	warn "Unknown REQ{BUILD}: $used" if $opt{d};
      }
    }
  }
}
print "REQ:\n".Dumper(\%REQ) if $opt{d};

print "# Constructing MOD\n" if $opt{v};
# construct MOD based on PM
foreach my $pm (keys %PM, keys %MOD)
{
  delete($MOD{$pm}) if $pm =~ m{/};
  $pm =~ s{^$WRKSRC/}{};
  while ($pm =~ m{^[a-z]+/}) {
    $pm =~ s{^[a-z]+/}{};
  };
  $pm =~ s{\.pm$}{};
  $pm =~ s{/}{::}g;
  $MOD{$pm} = 1;
}
print "MOD:\n".Dumper(\%MOD) if $opt{d};

# remove RUN from BUILD
foreach my $req (keys %{$REQ{RUN}})
{
  delete($REQ{BUILD}{$req});
}

print "# Remove dual-life modules\n" if $opt{v};
# remove the ones that already shipped with the minimum core
foreach my $type (keys %REQ)
{
  foreach my $req (keys %{$REQ{$type}})
  {
    my $ver = $PREREQ_PM->{$req} || 0;
    my $rel_level = level(Module::CoreList->first_release($req, $ver));
    my $perl_min_level = level($perl_min);
    printf("# %s was released in $rel_level\n", $ver ? "$req-$ver" : $req) if ($opt{d} && $rel_level > 0);
    next if $MOD{$req};
    printf("# rel_level:$rel_level, perl_min_level:$perl_min_level\n") if $opt{d};
    next if ($rel_level > 0 && $rel_level <= $perl_min_level);
    $DEP{$rel_level}{$type}{$req} = $rel_level;
  }
}
print "DEP:\n".Dumper(\%DEP) if $opt{d};

print "# Constructing PKG\n" if $opt{v};
my %PKG;
foreach my $ver (sort keys %DEP)
{
  foreach my $type (sort keys %{$DEP{$ver}})
  {
    foreach my $dep (sort keys %{$DEP{$ver}{$type}})
    {
      my $mod = $cb->module_tree($dep);
      next if !$mod;
      #next if $mod->module =~ m{^Encode|^encoding};
      #next if $mod->module =~ m{^Test::Pod};
      next if $mod->module =~ m{^ExtUtils::MM_};
      if ($mod->module =~ 'Module::Build' && $type eq 'BUILD')
      {
	$modbuild = 1;
	next;
      }
      my $pkg = $mod->package;
      my $pkgname = pkgname($pkg);
      my $path = $INDEX{$pkgname};
      if (!$path) {
	warn "$pkgname not found";
	next;
      }
      $PKG{$ver > 0 ? $ver : 999999}{$type}{$pkgname} = $dep;
      print "# $dep -> $pkg -> $pkgname -> $path\n" if $opt{d};
    }
  }
}
print "PKG:\n".Dumper(\%PKG) if $opt{d};
print "PREREQ_PM:\n" . Dumper($PREREQ_PM) . "\n" if $opt{d};

my %OUT;
my %out;
foreach my $ver (reverse sort keys %PKG)
{
  last if $ver < level($perl_used);
  foreach my $type (reverse sort keys %{$PKG{$ver}})
  {
    #next if $type eq 'BUILD';
    my $num = scalar(keys %{$PKG{$ver}{$type}});
    next if !$num;
    foreach my $pkgname (sort keys %{$PKG{$ver}{$type}})
    {
      next if $out{$pkgname};
      my $path = $INDEX{$pkgname};
      $OUT{999999}{'BUILD'} = "BUILD_DEPENDS=\t\${RUN_DEPENDS}\n" if !$OUT{999999}{'BUILD'};
      if (!$OUT{$ver}{$type}) {
	$OUT{$ver}{$type} .= sprintf("%s_DEPENDS%s=\t", $type, ($type eq 'BUILD' || $ver != 999999) ? "+" : "");
      } elsif ($OUT{$ver}{$type} eq "BUILD_DEPENDS=\t\${RUN_DEPENDS}\n") {
        $OUT{$ver}{$type} .= "BUILD_DEPENDS+=\t";
      } else {
	$OUT{$ver}{$type} .= " \\\n\t\t";
      }
      $OUT{$ver}{$type} .= sprintf("%s>=%s:%s/%s", $pkgname, $PREREQ_PM->{$PKG{$ver}{$type}{$pkgname}} || 0, '${PORTSDIR}', $path);
      $out{$pkgname} = 1;
    }
  }
}

print "OUT:\n".Dumper(\%OUT) if $opt{d};

# START output

print "\n";
if (exists($OUT{999999}))
{
  foreach my $type (reverse keys %{$OUT{999999}})
  {
    print $OUT{999999}{$type}."\n";
  }
  delete($OUT{999999});
}
printf("\nPERL_%s=\t%s\n", ($modbuild ? 'MODBUILD' : 'CONFIGURE'), (level($perl_used) > level($perl_min) ? ver($perl_used).'+' : 'yes'));
foreach my $ver (reverse keys %OUT)
{
  delete($OUT{$ver}) if $ver <= level($perl_min);
  delete($OUT{$ver}) if !scalar(keys %{$OUT{$ver}});
}
exit if !scalar(keys %OUT);
print "\n";
print ".include <bsd.port.pre.mk>\n";
foreach my $ver (keys %OUT)
{
  printf("\n.if %s < $ver\n", '${PERL_LEVEL}', $ver);
  foreach my $type (keys %{$OUT{$ver}})
  {
    print $OUT{$ver}{$type}."\n";
  }
  print ".endif\n";
}
print "\n.include <bsd.port.post.mk>\n";

END {
  print "cd $cwd && make clean\n" if $opt{v};
  `cd $cwd && make clean`;
  unlink($dat);
}
# END

sub ver
{
  my $ver = shift;
  $ver .= 0 if $ver =~ m{^\d+\.\d\d$};
  my ($x, $y, $z);
  ($x, $y, $z) = ($1, $2, $3) if $ver =~ m{^(\d+)\.?(\d{3})(\d*)$};
  ($x, $y, $z) = ($1, $2, $3) if $ver =~ m{^(\d+)\.(\d+)\.(\d+)$};
  ($x) = ($1) if $ver =~ m{^(\d+)$};
  return sprintf("%d.%d.%d", $x, $y, $z);
}

sub level
{
  my $ver = shift;
  $ver .= 0 if $ver =~ m{^\d+\.\d\d$};
  my ($x, $y, $z);
  ($x, $y, $z) = ($1, $2, $3) if $ver =~ m{^(\d+)\.?(\d{3})(\d*)$};
  ($x, $y, $z) = ($1, $2, $3) if $ver =~ m{^(\d+)\.(\d+)\.(\d+)$};
  ($x) = ($1) if $ver =~ m{^(\d+)$};
  return sprintf("%d%03d%02d", $x, $y, $z);
}

sub pkgname
{
  my $pkg = shift;
  return 'p5-Mail-Tools' if $pkg =~ m{^MailTools-\d+};
  if ($pkg =~ m{\.t(ar\.)?gz$})
  {
    $pkg =~ s{libnet}{Net};
    $pkg =~ s{^}{p5-} if $pkg !~ m{^perl-};
    $pkg =~ s{\.t(ar\.)?gz$}{};
    $pkg =~ s{-perl}{};
    $pkg =~ s{Term-}{} if $pkg =~ m{ReadLine};
    $pkg =~ s{Term}{Term-} if $pkg =~ m{TermReadKey};
  }
  $pkg =~ s{-v?[\d\.\w*,]+$}{};
  return $pkg;
}

sub wanted
{
  my $file = $_;
  my $dir = $File::Find::dir;
  my $path = $File::Find::name;
  return if ! -f $path;
  $PM{$path} = 1 if $path =~ m{.+?/blib/.+.pm$};
  #$PM{$path} = 1 if -x $path;
  $T{$path} = 1 if ($file =~ m{\.(t|PL)$} || $path =~ m{/t/});
  $MOD{$path} = 1 if $path =~ m{\.pm$};
}
